home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / pctj8404.arc / BOUNCE.BAS < prev    next >
BASIC Source File  |  1986-09-14  |  2KB  |  54 lines
  1. 1000  'Test routine for BOUNCE menu subroutine at 10000
  2. 1001  '
  3. 1002  '
  4. 1010  CLS
  5. 1020  BNUM=6:BX=25:BY=7:OLDBOUNCE=3:RESTORE 5050:GOSUB 10000    'Call BOUNCE
  6. 1030  IF ESCAPE=1 THEN CLS:PRINT"Aborted Choice":END            'Show choice
  7. 1040  CLS:PRINT"Bounce choice=";BOUNCE:END
  8. 1998  '
  9. 1999  '
  10. 5000  'Data statement archive
  11. 5001  '
  12. 5050  DATA "Set Time and Date","Enter Weekly Timesheets","Issue Paychecks","Issue W2 Forms","Update GL Master","Give Boss a Raise"
  13. 5999  '
  14. 9999  '
  15. 10000  '>>>>>Subroutine: Bounce
  16. 10010  '
  17. 10020  ESCAPE=0:BG=7:FG=0:LOCATE BY,BX,0        'Display menu choices
  18. 10030  FOR I=1 TO BNUM
  19. 10040    READ BB$(I):PRINT TAB(BX);CHR$(254);" ";BB$(I)
  20. 10050    PRINT
  21. 10060  NEXT
  22. 10070  BOUNCE=OLDBOUNCE:GOSUB 10300             'Highlight old choice #
  23. 10079  '
  24. 10080  'Keyboard polling loop
  25. 10090  '
  26. 10100  X$="":WHILE LEN(X$)=0:X$=INKEY$:WEND             'Get a keypress
  27. 10120  IF ASC(X$)=13 THEN COLOR 7,0:RETURN              'Was it (CR)?
  28. 10125  IF ASC(X$)=27 THEN ESCAPE=1:COLOR 7,0:RETURN     'Was it ESC?
  29. 10130  IF LEN(X$)<2 THEN SOUND 50,7:GOTO 10100          'Is it Extended?
  30. 10170  IF ASC(MID$(X$,2,1))=72 THEN 10240               'Is it up arrow?
  31. 10180  IF ASC(MID$(X$,2,1))<>80 THEN SOUND 50,7:GOTO 10100      'Down arrow?
  32. 10189  '
  33. 10190  OLDBOUNCE=BOUNCE                                 'Bounce down
  34. 10200  IF BOUNCE=BNUM THEN BOUNCE=1 ELSE BOUNCE=BOUNCE+1
  35. 10210  SWAP BOUNCE,OLDBOUNCE:GOSUB 10350                'Unhighlight old
  36. 10220  SWAP BOUNCE,OLDBOUNCE:GOSUB 10300                'Highlight new
  37. 10230  GOTO 10100
  38. 10239  '
  39. 10240  OLDBOUNCE=BOUNCE                                 'Bounce up
  40. 10250  IF BOUNCE=1 THEN BOUNCE=BNUM ELSE BOUNCE=BOUNCE-1
  41. 10260  SWAP BOUNCE,OLDBOUNCE:GOSUB 10350                'Unhighlight old
  42. 10270  SWAP BOUNCE,OLDBOUNCE:GOSUB 10300                'Highlight new
  43. 10280  GOTO 10100
  44. 10290  '
  45. 10300  '>>Minisub: Highlight Line
  46. 10310  '
  47. 10320  COLOR FG,BG:LOCATE BY+((BOUNCE-1)*2),BX+2:PRINT BB$(BOUNCE)
  48. 10330  RETURN
  49. 10340  '
  50. 10350  '>>Minisub: Normalize Line
  51. 10360  '
  52. 10370  BG=0:FG=7:GOSUB 10300:BG=7:FG=0
  53. 10380  RETURN
  54.